home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / SPX30.ZIP / DEMO03.ZIP / DEMO03.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-06-13  |  4.3 KB  |  185 lines
  1. Program Demo3;
  2.  
  3. { SPX library - Sprite demo 2  Copyright 1994 Scott D. Ramsay  }
  4.  
  5. Uses crt,spx_vga,spx_vsp,spx_key,spx_obj,spx_img,spx_tim,spx_sfn,spx_fnc;
  6.  
  7. const
  8.   path = '';
  9.   max  = 10;
  10.   framerate  : integer = 20;    { NOT in fps! }
  11.  
  12. type
  13.   Pballs = ^Tballs;
  14.   Tballs = object(Tobjs)
  15.              width,height,              { dimension of sprite }
  16.              kind,                      { sprite number }
  17.              ox,oy,                     { old position }
  18.              x,y,                       { new position }
  19.              lvl,                       { ball level number }
  20.              dx,dy : integer;           { direction }
  21.              constructor init(nx,ny,k,l:integer);
  22.              procedure drawitemobject;virtual;
  23.              procedure eraseitemobject;virtual;
  24.              procedure updateitemobject;virtual;
  25.              procedure calcitemobject;virtual;
  26.            end;
  27.  
  28. var
  29.   balls : array[0..2] of pointer;
  30.   pal   : RGBlist;
  31.   head,
  32.   tail  : plist;
  33.  
  34. procedure setup;
  35. var
  36.   p : plist;
  37.   d : integer;
  38. begin
  39.   openmode(5);
  40.   randomize;
  41.   setpageactive(5);
  42.   loadpcx(path+'virt1.pcx');
  43.   setpageactive(3);
  44.   loadpcx(path+'virt2.pcx');
  45.   loadvsp(path+'balls.vsp',balls);
  46.   loadcolors(path+'balls.pal',pal);
  47.   head := nil; tail := nil;
  48.   for d := 1 to max do
  49.     begin
  50.       new(p);
  51.       p^.item := new(Pballs,init(random(320),random(200),d mod 3,d shl 1));
  52.       p^.item^.powner := p;
  53.       addp(head,tail,p);
  54.     end;
  55.   fsetcolors(zdc);  { all black palette }
  56.   pcopy(5,4);       { copy virt page }
  57.   pcopy(3,2);       { copy to work page }
  58.   pcopy(3,1);       { copy to visual }
  59.   fadein(40,pal);
  60. end;
  61.  
  62.  
  63. procedure placespeed(mode:objmode);
  64. begin
  65.   case mode of
  66.     dDraw   : begin
  67.                putletter(5,5,5,st(framerate));
  68.                putletter(4,4,255,st(framerate));
  69.              end;
  70.     dErase  : CopyRect(4,4,50,12,pages[3]^,pages[2]^);
  71.     dUpdate : CopyRect(4,4,50,12,pages[2]^,pages[1]^);
  72.   end;
  73. end;
  74.  
  75.  
  76. procedure animate;
  77. var
  78.   p : pointer;
  79. begin
  80.   setpageactive(2);
  81.   setrate(1000);
  82.   repeat
  83.     f_clk[0] := framerate;
  84.     if key[KEY_PLUS] and (framerate<60)
  85.       then inc(framerate)
  86.       else
  87.         if key[KEY_MINUS] and (framerate>0)
  88.           then dec(framerate);
  89.     doallitems(head,dErase);
  90.     placespeed(dErase);
  91.     if not key[KEY_SPACE]
  92.       then doallitems(head,dCalc);
  93.     doallitems(head,dDraw);
  94.     placespeed(dDraw);
  95.     doallitems(head,dUpdate);
  96.     placespeed(dUpdate);
  97.     if key[KEY_ENTER]
  98.       then
  99.         begin
  100.           pcopy(4,1);
  101.           repeat until not key[KEY_ENTER];
  102.           pcopy(3,1);
  103.         end;
  104.     repeat until (f_clk[0]=0);
  105.   until key[KEY_ESC];
  106. end;
  107.  
  108. (**) { Tballs methods }
  109.  
  110. constructor Tballs.init(nx,ny,k,l:integer);
  111. begin
  112.   Tobjs.init;
  113.   kind := k;
  114.   lvl := l;
  115.   x := nx; y := ny; 
  116.   ox := x; oy := y;
  117.   repeat
  118.     dx := random(7)-3;
  119.     dy := random(7)-3;
  120.   until (dx<>0) and (dy<>0);
  121.   imagedims(balls[kind]^,width,height);
  122. end;
  123.  
  124.  
  125. procedure Tballs.eraseitemobject;
  126. begin
  127.   CopyRect(x,y,x+width-1,y+height-1,pages[5]^,pages[4]^);
  128.   CopyRect(ox,oy,ox+width-1,oy+height-1,pages[3]^,pages[2]^);
  129.   CopyRect(x,y,x+width-1,y+height-1,pages[3]^,pages[2]^);
  130. end;
  131.  
  132.  
  133. procedure Tballs.updateitemobject;
  134. begin
  135.   CopyRect(ox,oy,ox+width-1,oy+height-1,pages[2]^,pages[1]^);
  136.   CopyRect(x,y,x+width-1,y+height-1,pages[2]^,pages[1]^);
  137. end;
  138.  
  139.  
  140. procedure Tballs.drawitemobject;
  141. begin
  142.   displayer(x,y,balls[kind]^,pages[4]^,lvl);
  143.   dispvirt(x,y,balls[kind]^,pages[4]^,lvl);
  144. end;
  145.  
  146.  
  147. procedure Tballs.calcitemobject;
  148. begin
  149.   ox := x; oy := y;
  150.   inc(x,dx); inc(y,dy);
  151.   if (x<0) or (x>320-width)
  152.     then dx := -dx;
  153.   if (y<0) or (y>199-height)
  154.     then dy := -dy;
  155.   ifix(x,0,320-width);
  156.   ifix(y,0,200-height);
  157. end;
  158.  
  159.  
  160. procedure showit;
  161. begin
  162.   clrscr;
  163.   writeln('SPX library - Sprite demo 2');
  164.   writeln('Copyright 1993 Scott D. Ramsay');
  165.   writeln;
  166.   writeln('Keys:');
  167.   writeln(' ESC          - quit demo');
  168.   writeln(' +/-          - change frame speed');
  169.   writeln(' SPACE        - pause ');
  170.   writeln(' ENTER        - view sprite level page');
  171.   writeln;
  172.   write('Press SPACE to continue.');
  173.   clearbuffer;
  174.   repeat until key[KEY_SPACE];
  175. end;
  176.  
  177.  
  178. begin
  179.   showit;
  180.   setup;
  181.   animate;
  182.   clean_plist(head,tail);
  183.   closemode;
  184. end.
  185.